home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib15.dsk / WORD FIND.bas < prev   
BASIC Source File  |  2023-02-26  |  12KB  |  336 lines
  1. 10  REM  **************************
  2. 11  REM  *       WORD FIND        *
  3. 12  REM  * BY DAVID E. FAHNESTOCK *
  4. 13  REM  *   COPYRIGHT (C) 1983   *
  5. 14  REM  *   BY MICROSPARC, INC   *
  6. 15  REM  *   LINCOLN, MA. 01773   *
  7. 16  REM  **************************
  8. 220  REM **********************
  9. 230  REM *EPSON MX-80  PRINTER*
  10. 240  REM *COMMANDS  LOCATED AT*
  11. 250  REM *1060,1080, 1190,1210*
  12. 260  REM *      1390,2230     *
  13. 270  REM **********************
  14. 280  CLEAR : ONERR  GOTO 3390
  15. 290 D$ =  CHR$(4)
  16. 300  REM  *** CHECKS FOR PREVIOUS RUN OF PROGRAM. IF TRUE, BYPASS INTRO ***
  17. 310  IF  PEEK(0) = 1  THEN 560
  18. 320  TEXT : HOME : PRINT "** COPYRIGHT 1983 BY MICROSPARC, INC. **"
  19. 330  VTAB 11
  20. 340  HTAB 18: PRINT "W O R D"
  21. 350  VTAB 15
  22. 360  HTAB 18: PRINT "F I N D"
  23. 370  VTAB 15
  24. 380  FOR H = 1 TO 1000: NEXT 
  25. 390  VTAB 7
  26. 400  PRINT  TAB( 12)"S T D J W B O V S P"
  27. 410  PRINT 
  28. 420  PRINT  TAB( 12)"R B X V S Z B L E G"
  29. 430  PRINT 
  30. 440  PRINT  TAB( 12)"H U Q W O R D G T V"
  31. 450  PRINT 
  32. 460  PRINT  TAB( 12)"H P L A S Q I W L N"
  33. 470  PRINT 
  34. 480  PRINT  TAB( 12)"T O Z F I N D B I T"
  35. 490  PRINT 
  36. 500  PRINT  TAB( 12)"B R Y I S G W J O P"
  37. 510  PRINT 
  38. 520  PRINT  TAB( 12)"G J R I M X Q Z S C"
  39. 530 X = X +1
  40. 540  FOR H = 1 TO 1000: NEXT : IF X < >3  THEN  GOTO 320
  41. 550  POKE 0,1
  42. 560  HOME : GOSUB 2510: IF SE$ = "P"  THEN 1060
  43. 570  HOME 
  44. 580  INPUT "ENTER TITLE OF PUZZLE ";T$
  45. 590  VTAB 3: PRINT "ENTER THE NUMBER OF COLUMNS IN PUZZLE"
  46. 600  INPUT C
  47. 610  IF C <5  OR C >40  THEN 590
  48. 620  VTAB 6: PRINT "ENTER THE NUMBER OF ROWS IN PUZZLE"
  49. 630  INPUT R
  50. 640  IF R <5  OR R >40  THEN 620
  51. 650  PRINT 
  52. 660  PRINT "ENTER THE NUMBER OF WORDS TO FIND"
  53. 670  INPUT N
  54. 680  REM  ******DATA INITIATION******
  55. 690 CL$ =  CHR$(34): REM  QUOTATION MARK
  56. 700  DIM CL$(N),W$(N),LL$(40,40),L$(40,40),A$(26): IF SE$ = "P"  THEN 3250
  57. 710  REM  *** INITIALIZE ALPHABET ***
  58. 720  FOR L = 65 TO 90
  59. 730 I = I +1
  60. 740 A$(I) =  CHR$(L)
  61. 750  NEXT L
  62. 760  HOME 
  63. 770  FOR K = 1 TO N
  64. 780  PRINT "ENTER WORD # "K
  65. 790  INPUT W$(K): IF  LEN(W$(K)) = 0  THEN  PRINT  CHR$(7);: GOTO 790: REM  **CTRL-G IN QUOTES**
  66. 800  IF CL = 0  THEN 850
  67. 810  PRINT "ENTER CLUE"
  68. 820  PRINT "___________________________________[";
  69. 830  POKE 36,0: GOSUB 2780
  70. 840 CL$ =  CHR$(34): REM  *** QUOTATION MARK ***
  71. 850  NEXT K
  72. 860  HOME 
  73. 870  REM  *** FILLS MATRIX WITH PERIODS ***
  74. 880 I = 1:J = 1
  75. 890 L$(I,J) = "."
  76. 900 J = J +1
  77. 910  IF J < = R  THEN 890
  78. 920 I = I +1:J = 1
  79. 930  IF I < = C  THEN 890
  80. 940 T = 0
  81. 950 K = 1
  82. 960  REM  *** CLEAR SCREEN AND SET TOP MARGIN TO 16 ***
  83. 970  HOME : POKE 34,16
  84. 980  VTAB 12: HTAB 13: PRINT "PLEASE STAND-BY"
  85. 990  PRINT : HTAB 4: PRINT "WHILE I TRY TO INSERT THESE WORDS"
  86. 1000  PRINT : HTAB 12: PRINT "MATRIX SIZE "C" X "R
  87. 1010  PRINT : HTAB 16: PRINT K SPC( 2)W$(K)
  88. 1020  GOTO 1450
  89. 1030 K = K +1
  90. 1040  IF K < = N  THEN 970
  91. 1050  REM  *** TURN ON PRINTER ***
  92. 1060  POKE 34,0: HOME : VTAB 12: PRINT  TAB( 13)"TURN ON PRINTER": PRINT D$;"PR#1": PRINT  CHR$(9) +"80N"
  93. 1070  REM  ****TURN ON EMPHASIZE MODE****
  94. 1080  PRINT  CHR$(27)"E": HOME : GOSUB 1360
  95. 1090  GOSUB 2190
  96. 1100  PRINT 
  97. 1110  PRINT 
  98. 1120  FOR J = 1 TO R
  99. 1130  FOR I = 1 TO C
  100. 1140  PRINT LL$(I,J)" ";
  101. 1150  NEXT I
  102. 1160  PRINT 
  103. 1170  NEXT J
  104. 1180  REM  **** TURN OFF EMPHASIZED MODE ****
  105. 1190  PRINT  CHR$(27)"F": PRINT  CHR$(12): REM  FORM FEED
  106. 1200  REM  **** TURN OFF PRINTER ****
  107. 1210  PRINT : PRINT : PRINT D$;"PR#0"
  108. 1220  HOME : IF SE$ = "P"  THEN 1310
  109. 1230  VTAB 12: INPUT "WOULD YOU LIKE TO SAVE THIS PUZZLE?(Y/N)";SE$
  110. 1240  IF SE$ = "N"  THEN 1300
  111. 1250  IF SE$ < >"Y"  THEN 1230
  112. 1260  HOME : VTAB 12
  113. 1270  PRINT : PRINT "ENTER NAME OF PUZZLE --- OR ---": PRINT "'?' FOR CATALOG ";: INPUT "";DS$
  114. 1280  IF DS$ =  CHR$(63)  THEN  PRINT D$;"CATALOG": PRINT : GOTO 1270
  115. 1290  GOTO 2880
  116. 1300  HOME 
  117. 1310  VTAB 12: INPUT "WOULD YOU LIKE TO CREATE ANOTHER PUZZLE? (Y/N) ";SE$
  118. 1320  IF SE$ = "Y"  THEN  RUN 
  119. 1330  IF SE$ < >"N"  THEN 1310
  120. 1340  HOME : VTAB 12: HTAB 17: PRINT "GOOD BYE!";: POKE 216,0: END 
  121. 1350  REM  ****** PUZZLE PRINT ROUTINE ******
  122. 1360  FOR J = 1 TO R
  123. 1370  FOR I = 1 TO C
  124. 1380  PRINT L$(I,J)" ";
  125. 1390 LL$(I,J) = L$(I,J)
  126. 1400  NEXT I
  127. 1410  PRINT 
  128. 1420  NEXT J
  129. 1430  IF FF = 1  THEN  PRINT  CHR$(12);: REM  *** FORM FEED ***
  130. 1440  RETURN 
  131. 1450  REM  ****** WORD BREAKDOWN ROUTINE ******
  132. 1460 L0 =  LEN(W$(K))
  133. 1470  REM  ****** RANDOM SELECTION OF DIRECTION ******
  134. 1480  IF T <100  THEN 1500
  135. 1490  GOSUB 2440: GOTO 890: REM  *** WORD WILL NOT FIT--EXPAND MATRIX AND START OVER ***
  136. 1500 T = T +1:P = 1
  137. 1510 P0 = 1
  138. 1520 Q =  -1
  139. 1530  IF  RND(1) < = .5  THEN 1550
  140. 1540 Q = 1
  141. 1550 Q0 =  -1
  142. 1560  IF  RND(1) < = .5  THEN 1580
  143. 1570 Q0 = 1
  144. 1580 D = 2
  145. 1590  IF Q < >1  THEN 1610
  146. 1600 P = 0
  147. 1610  IF Q0 < >1  THEN 1630
  148. 1620 P0 = 0
  149. 1630  IF  RND(1) <.75  THEN 1650
  150. 1640 D = 1
  151. 1650  IF  RND(1) >.25  THEN 1670
  152. 1660 D = 0
  153. 1670  REM  ****** RANDOM SELECTION OF START POINT ******
  154. 1680 C0 = C
  155. 1690 R0 = R
  156. 1700  IF D < >1  THEN 1720
  157. 1710 R0 = R -L0
  158. 1720  IF D < >0  THEN 1740
  159. 1730 C0 = C -L0
  160. 1740  IF D < = 1  THEN 1770
  161. 1750 R0 = R -L0
  162. 1760 C0 = C -L0
  163. 1770  IF C0 < >C  THEN 1790
  164. 1780 P0 = 0
  165. 1790  IF R0 < >R  THEN 1810
  166. 1800 P = 0
  167. 1810 Z1 = ( RND(1) *R0/100 +.01) *100 +P *L0
  168. 1820 Z2 = ( RND(1) *C0/100 +.01) *100 +P0 *L0
  169. 1830 X1 =  INT(Z1)
  170. 1840 X2 =  INT(Z2)
  171. 1850  REM  ****** ENTRY OF WORD IN THE PUZZLE ******
  172. 1860  IF D = 1  THEN 2080
  173. 1870  IF D = 0  THEN 1980
  174. 1880  FOR I = 1 TO L0
  175. 1890  IF L$(X2 +(I -1) *Q0,X1 +(I -1) *Q) = "."  THEN 1910
  176. 1900  IF L$(X2 +(I -1) *Q0,X1 +(I -1) *Q) < > MID$ (W$(K),I,1)  THEN 1470
  177. 1910  NEXT I
  178. 1920 T = 0
  179. 1930  FOR I = 1 TO L0 -1
  180. 1940 L$(X2 +I *Q0,X1 +I *Q) =  MID$ (W$(K),I +1,1)
  181. 1950  NEXT I
  182. 1960 L$(X2,X1) =  MID$ (W$(K),1,1)
  183. 1970  GOTO 2170
  184. 1980  FOR I = 1 TO L0
  185. 1990  IF L$(X2 +(I -1) *Q0,X1) = "."  THEN 2010
  186. 2000  IF L$(X2 +(I -1) *Q0,X1) < > MID$ (W$(K),I,1)  THEN 1470
  187. 2010  NEXT I
  188. 2020 T = 0
  189. 2030  FOR I = 1 TO L0 -1
  190. 2040 L$(X2 +I *Q0,X1) =  MID$ (W$(K),I +1,1)
  191. 2050  NEXT I
  192. 2060 L$(X2,X1) =  MID$ (W$(K),1,1)
  193. 2070  GOTO 2170
  194. 2080  FOR I = 1 TO L0
  195. 2090  IF L$(X2,X1 +(I -1) *Q) = "."  THEN 2110
  196. 2100  IF L$(X2,X1 +(I -1) *Q) < > MID$ (W$(K),I,1)  THEN 1470
  197. 2110  NEXT I
  198. 2120 T = 0
  199. 2130  FOR I = 1 TO L0 -1
  200. 2140 L$(X2,X1 +I *Q) =  MID$ (W$(K),I +1,1)
  201. 2150  NEXT I
  202. 2160 L$(X2,X1) =  MID$ (W$(K),1,1)
  203. 2170  GOTO 1030
  204. 2180  REM  ****** FILL OF REMAINING POSITIONS ******
  205. 2190  FOR I = 1 TO C
  206. 2200  FOR J = 1 TO R
  207. 2210  IF LL$(I,J) > <"."  THEN 2240: REM  *** IF PERIOD IS FOUND, REPLACE WITH RANDOM LETTER ***
  208. 2220 Z1 =  INT(26 * RND(1)) +1
  209. 2230 LL$(I,J) = A$(Z1)
  210. 2240  NEXT J
  211. 2250  NEXT I
  212. 2260  REM  *** CENTER TITLE ON PAGE AND PRINT IN EXPANDED MODE ***
  213. 2270  VTAB 2: HTAB 35 - LEN(T$)/2: PRINT  CHR$(14)T$: PRINT 
  214. 2280  REM  *** PRINT WORDS OR CLUES ***
  215. 2290  PRINT :NU = 0:I = 15
  216. 2300  IF CC = 0  AND CL = 1  THEN CL = 0: GOTO 2320
  217. 2310  IF CL = 1  THEN I = 40
  218. 2320  FOR K = 1 TO N
  219. 2330  IF CL = 0  THEN  PRINT "("K") "W$(K);: GOTO 2370
  220. 2340  IF SE$ < >"P"  THEN N1 =  LEN(CL$(K)): GOTO 2360
  221. 2350 N1 =  LEN(CL$(K)) +1: REM  PREVENTS FIRST LETTER OF CLUE FROM BEING CHOPPED WHEN READING FROM DISK
  222. 2360  PRINT "("K") " RIGHT$(CL$(K),N1 -1);: GOTO 2380: REM  CHOPS OFF QUOTATION MARK BEFORE PRINTING
  223. 2370  POKE 36,I:NU = NU +1::I = I +15: GOTO 2390: REM  *** HORIZ. TAB FOR LIST OF WORDS ***
  224. 2380  POKE 36,I:I = I +40:NU = NU +1: GOTO 2410: REM  *** HORIZ. TAB FOR CLUES ***
  225. 2390  IF NU = 5  THEN NU = 0:I = 15: PRINT 
  226. 2400  GOTO 2420
  227. 2410  IF NU = 2  THEN NU = 0:I = 40: PRINT 
  228. 2420  NEXT K
  229. 2430  RETURN 
  230. 2440  HOME 
  231. 2450  REM  ****PUZZLE EXPANSION****
  232. 2460 R = R +1:C = C +1
  233. 2470  VTAB 16: HTAB 12: PRINT "MATRIX SIZE "R" X "C
  234. 2480 I = 1:J = 1
  235. 2490  RETURN 
  236. 2500  REM  ****** INSTRUCTIONS ******
  237. 2510  PRINT  TAB( 4)"WORD FIND IS AN ADAPTATION OF A": PRINT "PROGRAM CALLED ";: PRINT  CHR$(34);: PRINT "WORD GAME";: PRINT  CHR$(34);: PRINT " THAT APPEARED";: PRINT "IN THE BOOK ";: PRINT  CHR$(34);: PRINT "BASIC COMPUTER PROGRAMS FOR";
  238. 2520  PRINT "THE HOME";: PRINT  CHR$(34);: PRINT " BY CHARLES D. STERNBERG.": PRINT "IMPROVEMENTS HAVE BEEN MADE IN THE": PRINT "ORIGINAL PROGRAM TO MAKE IT MORE USEFUL": PRINT "AND EASIER TO USE.": PRINT 
  239. 2530  PRINT  TAB( 4)"ONE OF THE IMPROVEMENTS CAUSES THE": PRINT "COMPUTER TO AUTOMATICALLY ENLARGE THE": PRINT "SIZE OF THE MATRIX, TO ACCOMMODATE THE": PRINT "NUMBER AND SIZE OF THE WORDS TO BE": PRINT "HIDDEN.": PRINT 
  240. 2540  PRINT  TAB( 4)"START WITH A MATRIX SIZE THAT IS": PRINT "SLIGHTLY TOO SMALL FOR THE NUMBER OF": PRINT "WORDS CHOSEN.  FOR EXAMPLE, YOU WANT TO": PRINT "USE FIFTEEN (15) WORDS.  START OUT WITH": PRINT "TEN (10) COLUMNS AND TEN (10) ROWS.  THE";
  241. 2550  PRINT "PROGRAM WILL AUTOMATICALLY EXPAND THE": PRINT "ROWS AND COLUMNS UNTIL THE WORDS FIT."
  242. 2560  PRINT : PRINT  TAB( 7)"PRESS ANY KEY TO CONTINUE"
  243. 2570  VTAB 23: HTAB 7: GET SE$
  244. 2580  HOME : VTAB 1
  245. 2590  PRINT  TAB( 4)"ONCE A PUZZLE HAS BEEN CREATED IT CAN";: PRINT "BE SAVED ON DISK FOR LATER USE.": PRINT 
  246. 2600  PRINT  TAB( 4)"YOU HAVE THE CHOICE OF CREATING": PRINT "EITHER ONE OF TWO PUZZLES.  THE FIRST": PRINT "PUZZLE WILL PRINT A LIST OF THE WORDS": PRINT "THAT ARE TO BE LOCATED IN THE PUZZLE.": PRINT "THE SECOND PUZZLE WILL PRINT ONLY A LIST";
  247. 2610  PRINT "OF THE CLUES FOR EACH HIDDEN WORD."
  248. 2620  PRINT : PRINT  TAB( 4)"(EXAMPLE) THE HIDDEN WORD IS FIG; THE";: PRINT "CLUE COULD BE----";: PRINT "ADAM'S FIRST CLOTHES.": PRINT "(GEN. 3:7)"
  249. 2630  VTAB 16: INPUT "WOULD YOU LIKE TO USE CLUES? (Y/N) ";SE$
  250. 2640  IF  LEFT$(SE$,1) = "N"  THEN CL = 0:CC = 0: GOTO 2670
  251. 2650  IF  LEFT$(SE$,1) < >"Y"  THEN 2630
  252. 2660 CL = 1:CC = 1
  253. 2670  VTAB 18: PRINT "WOULD YOU LIKE THE SOLUTION TO BE ": INPUT "PRINTED ON A SEPARATE SHEET? (Y/N) ";SE$
  254. 2680  IF  LEFT$(SE$,1) = "Y"  THEN FF = 1: GOTO 2710
  255. 2690  IF  LEFT$(SE$,1) < >"N"  THEN 2670
  256. 2700 FF = 0
  257. 2710  VTAB 21: INPUT "WOULD YOU LIKE TO CREATE A NEW PUZZLE ORUSE A PREVIOUS ONE? (N/P) ";SE$
  258. 2720  IF SE$ = "N"  THEN 2770
  259. 2730  IF SE$ < >"P"  THEN 2710
  260. 2740  PRINT : PRINT "ENTER NAME OF PUZZLE --- OR ---": PRINT "'?' FOR CATALOG ";: INPUT "";DS$
  261. 2750  IF DS$ =  CHR$(63)  THEN  PRINT D$;"CATALOG": GOTO 2740
  262. 2760  GOSUB 3140
  263. 2770  RETURN 
  264. 2780  REM 
  265. 2790  REM  *** THE FOLLOWING ROUTINE CONCATENATES A QUOTATION MARK ONTO CL$ ALLOWING COMMAS AND COLONS TO BE USED IN YOUR CLUES ***
  266. 2800  REM  *** INPUT ANYTHING ROUTINE ***
  267. 2810  REM 
  268. 2820  REM 
  269. 2830  GET C$: PRINT C$;: IF C$ =  CHR$(13)  THEN  RETURN 
  270. 2840  IF C$ =  CHR$(8)  THEN CL$ =  LEFT$(CL$, LEN(CL$) -1): GOTO 2830
  271. 2850 CL$ = CL$ +C$
  272. 2860 CL$(K) = CL$
  273. 2870  GOTO 2830
  274. 2880  REM  *** PUZZLE SAVE ***
  275. 2890  PRINT D$;"OPEN";DS$
  276. 2900  PRINT D$;"DELETE";DS$
  277. 2910  PRINT D$;"OPEN";DS$
  278. 2920  PRINT D$;"WRITE";DS$
  279. 2930  PRINT R
  280. 2940  PRINT C
  281. 2950  PRINT K
  282. 2960  PRINT CL
  283. 2970 N = K -1
  284. 2980  PRINT N
  285. 2990  PRINT T$
  286. 3000  FOR I = 1 TO N
  287. 3010  PRINT W$(I)
  288. 3020  IF CL = 1  THEN  PRINT CL$(I)
  289. 3030  NEXT I
  290. 3040  FOR J = 1 TO R
  291. 3050  FOR I = 1 TO C
  292. 3060  PRINT L$(I,J)
  293. 3070  NEXT I
  294. 3080  NEXT J
  295. 3090  FOR I = 1 TO 26
  296. 3100  PRINT A$(I)
  297. 3110  NEXT I
  298. 3120  PRINT D$;"CLOSE"DS$
  299. 3130  GOTO 1300
  300. 3140  REM  *** PUZZLE READ ***
  301. 3150  PRINT D$;"OPEN";DS$
  302. 3160  PRINT D$;"READ";DS$
  303. 3170  INPUT R
  304. 3180  INPUT C
  305. 3190  INPUT K
  306. 3200  INPUT CL
  307. 3210 N = K -1
  308. 3220  INPUT N
  309. 3230  INPUT T$
  310. 3240  GOTO 700: REM  *** DIM ARRAYS ***
  311. 3250  FOR I = 1 TO N
  312. 3260  INPUT W$(I)
  313. 3270  IF CL = 1  THEN  INPUT CL$(I)
  314. 3280  NEXT I
  315. 3290  FOR J = 1 TO R
  316. 3300  FOR I = 1 TO C
  317. 3310  INPUT L$(I,J)
  318. 3320  NEXT I
  319. 3330  NEXT J
  320. 3340  FOR I = 1 TO 26
  321. 3350  INPUT A$(I)
  322. 3360  NEXT I
  323. 3370  PRINT D$;"CLOSE"DS$
  324. 3380  RETURN 
  325. 3390  REM  *** ERROR ROUTINE ***
  326. 3400  POKE 216,0:ER =  PEEK(222)
  327. 3410  IF ER = 4  THEN 3460
  328. 3420  IF ER = 5  THEN 3470
  329. 3430  IF ER = 10  THEN 3480
  330. 3440  IF ER = 53  THEN 3490
  331. 3450  POKE 34,0: HOME : VTAB 12: HTAB 5: PRINT "AN ERROR HAS BEEN ENCOUNTERED": PRINT : HTAB 7: PRINT "PRESS ANY KEY TO CONTINUE ";: GET SE$: GOTO 280
  332. 3460  POKE 34,0: HOME : VTAB 12: HTAB 6: PRINT "WRITE PROTECT TAB ON DISKETTE!": PRINT : PRINT  TAB( 15)"PLEASE REMOVE": PRINT : PRINT  TAB( 8)"PRESS ANY KEY TO CONTINUE";: GET SE$: HOME : GOTO 1270
  333. 3470  POKE 34,0: HOME : VTAB 12: HTAB 10: PRINT "NO PUZZLE BY THAT NAME!": PRINT : HTAB 8: PRINT "PRESS ANY KEY TO CONTINUE ";: GET SE$: HOME : GOTO 2710
  334. 3480  POKE 34,0: HOME : VTAB 12: HTAB 15: PRINT "FILE LOCKED!": PRINT : PRINT  TAB( 5)"CHOOSE ANOTHER NAME FOR PUZZLE": PRINT : PRINT  TAB( 8)"PRESS ANY KEY TO CONTINUE ";: GET SE$: HOME : GOTO 1270
  335. 3490 R =  LEN(W$(K)):C =  LEN(W$(K))
  336. 3500 I = 1:J = 1: GOTO 890